Endowment Spenddown

Rose Evard

2023-03-27

# make kable table with consistent formatting
make_table <- function(..., title = "", col_names = c("")) {
  title <- paste0("<center><span style = 'font-size:150%;color:black'><b>",
                  title,
                  "</span></b><center>")
   as_tibble(...) %>%
    kbl(caption = title,
        col.names = col_names) %>%
    kable_material() %>%
    row_spec(row=0, background = "#43494C" , color = "white", bold = TRUE)
}
## Loading in data
endowment_data <- read_rds(here("data", "endowment_filter_data_990.RDS"))
names <- read_csv(here("data", "companies.csv")) %>% 
  mutate(EIN = as.character(ein)) %>%
  select(-ein)
## Rows: 308 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): organization_name
## dbl (2): EIN, ein
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

Calculating Percent Spend Down

## Calculating Spend Down, NOT including the CYMs   
## 100 - (EYE/BYB * 100)
spend_down_calc1 <- endowment_data %>%
  filter(!is.na(CYBeginningYearBalanceAmt)) %>%
  mutate(spend_down = 100 - (CYEndYearBalanceAmt/CYBeginningYearBalanceAmt * 100)) %>%
  arrange(desc(spend_down)) %>%
  select(EIN, CYEndYearBalanceAmt, CYBeginningYearBalanceAmt, spend_down)

spend_down_calc1 %>%   
  filter(!is.na(spend_down) & spend_down != -Inf) %>%
  summarize(avg_spend_down = mean(spend_down),
            median_spend_down = median(spend_down),
            sd_spend_down = sd(spend_down))

ggplot(spend_down_calc1, aes(x = spend_down)) +
  geom_histogram(binwidth = 10) + 
  xlab("Spend Down") + 
  ggtitle(label = "Histogram", subtitle = "Spend Down = 100 - (EYB / BYB * 100)")
## Calculating Spend Down, NOT including the CYMs   
## EYE/BYB * 100
spend_down_calc2 <- endowment_data %>%
  filter(!is.na(CYBeginningYearBalanceAmt)) %>%
  mutate(spend_down = (CYEndYearBalanceAmt/CYBeginningYearBalanceAmt * 100)) %>%
  arrange(desc(spend_down)) %>%
  select(EIN, CYEndYearBalanceAmt, CYBeginningYearBalanceAmt, spend_down)

spend_down_calc2 %>%   
  filter(!is.na(spend_down) & spend_down != -Inf) %>%
  summarize(avg_spend_down = mean(spend_down),
            median_spend_down = median(spend_down),
            sd_spend_down = sd(spend_down))

ggplot(spend_down_calc2, aes(x = spend_down)) +
  geom_histogram(binwidth = 10) + 
  xlab("Spend Down") + 
  ggtitle(label = "Histogram", subtitle = "Spend Down = (EYB / BYB * 100)")
## Calculating Spend Down, NOT including the CYMs   
## (EYB - BYB)/BYB * 100
## Rose has notes on her choice for this calculation
spend_down <- endowment_data %>%
  filter(!is.na(CYBeginningYearBalanceAmt)) %>%
  mutate(spend_down = CYEndYearBalanceAmt - CYBeginningYearBalanceAmt,
         pct_spend_down = spend_down/CYBeginningYearBalanceAmt * 100) %>%
  arrange(desc(pct_spend_down)) %>%
  left_join(names, by = "EIN")

# Basic summary stats
spend_down %>%   
  filter(!is.na(pct_spend_down) & pct_spend_down != Inf) %>%
  summarize(avg_spend_down = mean(pct_spend_down),
            median_spend_down = median(pct_spend_down),
            sd_spend_down = sd(pct_spend_down))
spend_down %>%   
  filter(!is.na(pct_spend_down) & pct_spend_down != Inf) %>%
  group_by(EIN) %>%
  summarize(avg_spend_down = mean(pct_spend_down),
            median_spend_down = median(pct_spend_down),
            sd_spend_down = sd(pct_spend_down))
# Basic histogram summarizing it
ggplot(spend_down, aes(x = pct_spend_down)) +
  geom_histogram(binwidth = 20) + 
  xlab("% Spend Down\n(EYB - BYB) / BYB * 100") + 
  ggtitle(label = "Percentage of Spend Down", subtitle = "Red Line indicates 100%") +
  theme_classic() + 
  geom_vline(xintercept = 100, color = "maroon", linetype = "dotted")

spend_down %>%
  filter(pct_spend_down != Inf) %>%
  select(organization_name, fiscal_year, pct_spend_down) %>%
  make_table(title = "Percent Spend Down", col_names = c("Name", "Fiscal Year", "% Spend Down")) %>%
  scroll_box(height = "450px")
Percent Spend Down
Name Fiscal Year % Spend Down
Ballet Arizona 2017 3621.7694455
Joffrey Ballet 2015 747.2041559
Ballet Hispanico 2021 432.1555786
First State Ballet Theatre 2020 242.6848638
Atlanta Ballet 2017 207.7002614
Nashville Ballet 2016 206.2101382
Grand Rapids Ballet 2015 186.0427033
Joffrey Ballet 2019 146.9046722
Texas Ballet Theater 2015 133.3333333
Miami City Ballet 2021 103.3796951
Ballet Memphis 2018 100.3575811
Joffrey Ballet 2020 90.8216917
Ballet Austin 2017 90.2783217
Texas Ballet Theater 2018 85.8401625
BalletMet 2018 85.0249761
Atlanta Ballet 2016 81.8387443
First State Ballet Theatre 2019 69.9900000
Richmond Ballet 2018 57.4030070
First State Ballet Theatre 2016 53.2556470
Dayton Ballet 2019 47.3628143
Ballet Des Moines 2018 40.4800000
Richmond Ballet 2020 39.8449675
Eugene Ballet 2021 35.3676599
Richmond Ballet 2019 34.8263002
First State Ballet Theatre 2017 32.2270270
New Mexico Ballet Company 2019 28.7289611
Aspen Santa Fe Ballet 2017 27.9853981
Richmond Ballet 2017 27.4751409
Miami City Ballet 2018 26.9869980
Ballet Memphis 2017 26.3332143
BalletMet 2019 22.9766213
Pittsburgh Ballet Theatre 2021 20.2563462
Joffrey Ballet 2018 20.1054139
San Francisco Ballet 2017 18.7877861
Nashville Ballet 2017 18.7510970
Joffrey Ballet 2016 17.1525667
Grand Rapids Ballet 2020 16.5116257
New York City Ballet 2018 16.3644199
Joffrey Ballet 2017 15.8506700
Houston Ballet 2017 15.6387481
Tulsa Ballet 2018 15.3823425
NA 2018 15.2551406
Aspen Santa Fe Ballet 2016 15.1095158
Pacific Northwest Ballet 2017 15.0137712
American Ballet Theatre 2017 14.9425672
Kansas City Ballet 2015 14.6091861
Tulsa Ballet 2015 14.4923885
Kansas City Ballet 2019 14.2884428
Tulsa Ballet 2019 14.0998602
Atlanta Ballet 2018 13.6920172
New York City Ballet 2017 13.0492346
Tulsa Ballet 2017 12.8725445
American Ballet Theatre 2019 12.8340039
The Tallahassee Ballet 2015 12.7775722
Pittsburgh Ballet Theatre 2018 12.4892577
Alvin Ailey American Dance Theater 2017 11.5365116
Atlanta Ballet 2015 11.3598829
Grand Rapids Ballet 2019 11.2809947
The Charleston Ballet 2017 10.7069912
Charlotte Ballet 2017 10.3333680
NA 2017 9.7115934
Charlotte Ballet 2015 9.1252970
Ballet Austin 2020 8.9689362
American Ballet Theatre 2020 8.9365465
Fort Wayne Ballet 2017 8.7036880
Milwaukee Ballet 2017 8.6823347
Ballet West 2015 8.5436426
Charlotte Ballet 2016 8.5301897
Madison Ballet 2017 8.2709975
Ballet West 2020 8.0887426
Charlotte Ballet 2018 8.0057600
NA 2019 7.8186556
The Charleston Ballet 2018 7.7078009
Kansas City Ballet 2017 7.6710943
Miami City Ballet 2017 7.4251152
Tulsa Ballet 2020 7.2630153
Pittsburgh Ballet Theatre 2017 7.1356111
NA 2020 6.8383787
Grand Rapids Ballet 2017 6.7800620
The Tallahassee Ballet 2017 6.6393657
NA 2016 6.4755945
The Sarasota Ballet 2017 6.4328584
Ballet Des Moines 2019 6.2713554
Pacific Northwest Ballet 2018 6.0980960
Grand Rapids Ballet 2018 5.6995093
The Sarasota Ballet 2020 5.3797096
Milwaukee Ballet 2018 5.3251625
Pacific Northwest Ballet 2020 5.2552006
Tulsa Ballet 2016 5.1996153
Madison Ballet 2018 5.1952964
San Francisco Ballet 2018 5.0127410
Ballet Hispanico 2017 4.8257031
Ballet Austin 2018 4.6407201
Oregon Ballet Theatre 2019 4.1823644
American Ballet Theatre 2015 3.9081263
Alvin Ailey American Dance Theater 2019 3.5551869
Houston Ballet 2018 3.5239698
The Tallahassee Ballet 2019 3.4501860
Oregon Ballet Theatre 2017 3.4233093
The Tallahassee Ballet 2018 3.2518997
Ballet Quad Cities 2017 3.2100411
Nashville Ballet 2018 3.1497842
Houston Ballet 2019 3.0126539
Ballet West 2016 2.9479559
Pennsylvania Ballet 2017 2.7458153
Ballet Austin 2019 2.7039028
Alvin Ailey American Dance Theater 2018 2.6520142
Pacific Northwest Ballet 2019 2.5299841
Eugene Ballet 2020 2.0266667
Alvin Ailey American Dance Theater 2015 2.0168085
Oregon Ballet Theatre 2020 1.9913020
Oregon Ballet Theatre 2021 1.5619387
Ballet Hispanico 2019 1.5405288
Nashville Ballet 2015 1.3707995
Kansas City Ballet 2016 1.3182366
Miami City Ballet 2019 1.1650569
Alvin Ailey American Dance Theater 2020 1.1173579
Madison Ballet 2020 1.0503166
Pennsylvania Ballet 2020 0.9848159
Nevada Ballet Theatre 2018 0.9818432
Fort Wayne Ballet 2018 0.9437819
Pittsburgh Ballet Theatre 2019 0.8461817
Pennsylvania Ballet 2018 0.8212002
Nashville Ballet 2020 0.6340668
Pacific Northwest Ballet 2015 0.6277229
The Alabama Ballet 2020 0.5951924
Texas Ballet Theater 2019 0.5813097
Texas Ballet Theater 2020 0.5742863
Colorado Ballet 2015 0.5500000
Fort Wayne Ballet 2019 0.4949803
Ballet Hispanico 2018 0.4786320
Milwaukee Ballet 2015 0.2558318
New Mexico Ballet Company 2020 0.2184921
Oregon Ballet Theatre 2018 0.1654999
Ballet Hispanico 2016 0.1309318
New York City Ballet 2019 0.0809932
Texas Ballet Theater 2017 0.0285424
Texas Ballet Theater 2016 0.0199837
Dance Theatre of Harlem 2015 0.0000000
The Sarasota Ballet 2015 0.0000000
BalletMet 2015 0.0000000
Ballet Arizona 2015 0.0000000
BalletMet 2016 0.0000000
San Francisco Ballet 2015 0.0000000
American Repertory Ballet 2016 0.0000000
Eugene Ballet 2016 0.0000000
The Alabama Ballet 2016 0.0000000
Ballet Arizona 2016 0.0000000
Dance Theatre of Harlem 2016 0.0000000
San Francisco Ballet 2016 0.0000000
BalletMet 2017 0.0000000
The Alabama Ballet 2017 0.0000000
Dance Theatre of Harlem 2017 0.0000000
American Repertory Ballet 2017 0.0000000
Dance Theatre of Harlem 2018 0.0000000
The Washington Ballet 2018 0.0000000
The Alabama Ballet 2018 0.0000000
Eugene Ballet 2018 0.0000000
Eugene Ballet 2019 0.0000000
Aspen Santa Fe Ballet 2019 0.0000000
Dance Theatre of Harlem 2019 0.0000000
Aspen Santa Fe Ballet 2020 0.0000000
BalletMet 2020 0.0000000
The Washington Ballet 2020 0.0000000
Dance Theatre of Harlem 2020 0.0000000
NA 2015 -0.0388779
Nevada Ballet Theatre 2020 -0.0958192
Milwaukee Ballet 2019 -0.2192253
Ballet Hispanico 2020 -0.2921837
Ballet Arizona 2018 -0.2958794
The Washington Ballet 2015 -0.3307636
Nevada Ballet Theatre 2015 -0.4171208
San Francisco Ballet 2019 -0.4505953
Houston Ballet 2020 -0.5394078
Aspen Santa Fe Ballet 2015 -0.6154796
Madison Ballet 2019 -0.6341596
Pennsylvania Ballet 2019 -0.6773370
Nevada Ballet Theatre 2016 -0.7510343
Nevada Ballet Theatre 2021 -0.8682968
Houston Ballet 2015 -0.9290425
American Ballet Theatre 2016 -0.9486236
Nevada Ballet Theatre 2019 -0.9524021
Ballet West 2018 -1.0492992
New York City Ballet 2015 -1.0935295
Charlotte Ballet 2019 -1.1038242
Nevada Ballet Theatre 2017 -1.1116605
Milwaukee Ballet 2016 -1.1445611
Ballet Hispanico 2015 -1.2189376
Ballet Arizona 2019 -1.3078878
Ballet Arizona 2020 -1.3712710
The Charleston Ballet 2016 -1.5786659
Madison Ballet 2016 -1.6090293
Fort Wayne Ballet 2020 -1.6147683
Pennsylvania Ballet 2015 -2.1126469
The Charleston Ballet 2015 -2.8140235
New York City Ballet 2020 -2.9450705
American Ballet Theatre 2018 -3.0002561
Charlotte Ballet 2020 -3.0415463
American Ballet Theatre 2014 -3.2115030
Pittsburgh Ballet Theatre 2020 -3.3144664
Grand Rapids Ballet 2016 -3.4832176
Ballet West 2017 -3.5593957
Ballet Austin 2016 -3.6649665
The Alabama Ballet 2019 -3.6897295
Kansas City Ballet 2018 -3.7141912
The Tallahassee Ballet 2020 -4.1994951
Pennsylvania Ballet 2016 -4.2562307
Ballet Quad Cities 2020 -4.5315904
Miami City Ballet 2020 -4.8106966
Houston Ballet 2016 -4.9809760
Ballet Memphis 2015 -5.1492312
The Tallahassee Ballet 2016 -5.8413323
The Sarasota Ballet 2018 -5.8747682
Ballet Memphis 2016 -5.9367915
Ballet Memphis 2019 -6.1694703
Alvin Ailey American Dance Theater 2016 -7.2545116
Pacific Northwest Ballet 2016 -7.3246969
New York City Ballet 2016 -7.4654042
Madison Ballet 2015 -7.5915755
San Francisco Ballet 2020 -8.4597794
Pittsburgh Ballet Theatre 2015 -9.7519131
Ballet Quad Cities 2016 -9.9700000
Ballet Memphis 2020 -11.6985509
Pittsburgh Ballet Theatre 2016 -13.8628328
The Sarasota Ballet 2019 -15.1497071
The Washington Ballet 2016 -25.5508697
Atlanta Ballet 2020 -28.5158513
Atlanta Ballet 2019 -36.6916144
The Washington Ballet 2017 -48.7379222
First State Ballet Theatre 2015 -49.5289330
The Washington Ballet 2019 -50.1144953
First State Ballet Theatre 2018 -72.7468454
Orlando Ballet 2020 -90.9983829
Nashville Ballet 2019 -94.4004512

(End Year Balance - Beginning Year Balance) / Beginning Year Balance * 100

If EYB is larger, positive result. Meaning there was a INCREASE in total funds.
If BYB is larger, negative result. Meaning a DECREASE in total funds. If result is above 100, the fund was at least DOUBLED.

## Spend Down over Time
spend_down_plot <- spend_down %>%
  ggplot(aes(x = fiscal_year, y = pct_spend_down, 
             group = organization_name, color = organization_name)) +
  geom_line(alpha = 0.5) + 
  theme_bw() + 
  labs(y = "Percent Spend Down",
       x = "Fiscal Year",
       title = "Percentage of Endowment Spend Down",
       subtitle = "By Fiscal Year") + 
  theme(plot.title = element_text(size = 10, face = "bold", hjust = .5),
        axis.title = element_text(size = 12, face = "bold"),
        plot.subtitle = element_text(size = 5, face = "italic", hjust = .5),
        axis.text.x = element_text(size = 10, angle = 25),
        strip.text = element_text(face="bold",size = 5),
        legend.key.size = unit(1, 'mm'),
        legend.text = element_text(size=7)) + 
  scale_y_continuous(labels = scales::comma_format(),
                     breaks = scales::pretty_breaks(n = 20)) +
  geom_hline(yintercept = 100, linetype = "dotted", color = "gray")
ggplotly(spend_down_plot) %>%
  layout(showlegend = FALSE)
## Spend Down over Time
### WITHOUT ARIAZONA
spend_down_plot <- spend_down %>%
  filter(organization_name != "Ballet Arizona") %>% 
  ggplot(aes(x = fiscal_year, y = pct_spend_down, 
             group = organization_name, color = organization_name)) +
  geom_line(show.legend = FALSE, alpha = 0.5) + 
  theme_bw() + 
  labs(y = "Percent Spend Down",
       x = "Fiscal Year",
       title = "Percentage of Endowment Spend Down",
       subtitle = "By Fiscal Year") + 
  theme(plot.title = element_text(size = 10, face = "bold", hjust = .5),
        axis.title = element_text(size = 12, face = "bold"),
        plot.subtitle = element_text(size = 5, face = "italic", hjust = .5),
        axis.text.x = element_text(size = 10, angle = 25),
        strip.text = element_text(face="bold",size = 5),
        legend.key.size = unit(1, 'mm'),
        legend.text = element_text(size=7)) + 
  scale_y_continuous(labels = scales::comma_format(),
                     breaks = scales::breaks_pretty(n = 20)) +
  geom_hline(yintercept = 100, linetype = "dotted", color = "gray")
ggplotly(spend_down_plot) %>%
  layout(showlegend = FALSE)
##Plot with Y scale between -100 and 100 
limited_scale <- spend_down %>%
  ggplot(aes(x = fiscal_year, y = pct_spend_down, 
             group = organization_name, color = organization_name)) +
  geom_line(show.legend = FALSE, alpha = 0.5) + 
  theme_bw() + 
  labs(y = "Percent Spend Down",
       x = "Fiscal Year",
       title = "Percentage of Endowment Spend Down (max 100)",
       subtitle = "By Fiscal Year") + 
  theme(plot.title = element_text(size = 10, face = "bold", hjust = .5),
        axis.title = element_text(size = 12, face = "bold"),
        plot.subtitle = element_text(size = 5, face = "italic", hjust = .5),
        axis.text.x = element_text(size = 10, angle = 25),
        strip.text = element_text(face="bold",size = 5),
        legend.key.size = unit(1, 'mm'),
        legend.text = element_text(size=7)) + 
  scale_y_continuous(labels = scales::comma_format(),
                     breaks = scales::pretty_breaks(n = 20),
                     limits = c(-100, 100))
ggplotly(limited_scale) %>%
  layout(showlegend = FALSE)
## Pandemic Years
spend_down_plot <- spend_down %>%
  filter(fiscal_year %in% c("2018", "2019", "2020", "2021", "2022")) %>% 
  ggplot(aes(x = fiscal_year, y = pct_spend_down, 
             group = organization_name, color = organization_name)) +
  geom_line(show.legend = FALSE, alpha = 0.5) + 
  theme_bw() + 
  labs(y = "Percent Spend Down",
       x = "Fiscal Year",
       title = "Percentage of Endowment Spend Down",
       subtitle = "Within Pandemic Years") + 
  theme(plot.title = element_text(size = 10, face = "bold", hjust = .5),
        axis.title = element_text(size = 12, face = "bold"),
        plot.subtitle = element_text(size = 5, face = "italic", hjust = .5),
        axis.text.x = element_text(size = 10, angle = 25),
        strip.text = element_text(face="bold",size = 5),
        legend.key.size = unit(1, 'mm'),
        legend.text = element_text(size=7)) + 
  scale_y_continuous(labels = scales::comma_format(),
                     breaks = scales::pretty_breaks(n = 20)) +
  geom_hline(yintercept = 100, linetype = "dotted", color = "gray")
ggplotly(spend_down_plot)  %>%
  layout(showlegend = FALSE)
## Table of available in-pandemic data 
spend_down %>%
  filter(fiscal_year %in% c("2019", "2020", "2021", "2022")) %>%
  select(organization_name, pct_spend_down, fiscal_year) %>%
  arrange(desc(fiscal_year)) %>%
  make_table(title = "Percent Spend Down within Pandemic Years", col_names = c("Name", "% Spend Down", "Year")) %>%
  scroll_box(height = "450px")
Percent Spend Down within Pandemic Years
Name % Spend Down Year
Ballet Hispanico 432.1555786 2021
Miami City Ballet 103.3796951 2021
Eugene Ballet 35.3676599 2021
Pittsburgh Ballet Theatre 20.2563462 2021
Oregon Ballet Theatre 1.5619387 2021
Nevada Ballet Theatre -0.8682968 2021
First State Ballet Theatre 242.6848638 2020
Joffrey Ballet 90.8216917 2020
Richmond Ballet 39.8449675 2020
Grand Rapids Ballet 16.5116257 2020
Ballet Austin 8.9689362 2020
American Ballet Theatre 8.9365465 2020
Ballet West 8.0887426 2020
Tulsa Ballet 7.2630153 2020
NA 6.8383787 2020
The Sarasota Ballet 5.3797096 2020
Pacific Northwest Ballet 5.2552006 2020
Eugene Ballet 2.0266667 2020
Oregon Ballet Theatre 1.9913020 2020
Alvin Ailey American Dance Theater 1.1173579 2020
Madison Ballet 1.0503166 2020
Pennsylvania Ballet 0.9848159 2020
Nashville Ballet 0.6340668 2020
The Alabama Ballet 0.5951924 2020
Texas Ballet Theater 0.5742863 2020
New Mexico Ballet Company 0.2184921 2020
Aspen Santa Fe Ballet 0.0000000 2020
BalletMet 0.0000000 2020
The Washington Ballet 0.0000000 2020
Dance Theatre of Harlem 0.0000000 2020
Nevada Ballet Theatre -0.0958192 2020
Ballet Hispanico -0.2921837 2020
Houston Ballet -0.5394078 2020
Ballet Arizona -1.3712710 2020
Fort Wayne Ballet -1.6147683 2020
New York City Ballet -2.9450705 2020
Charlotte Ballet -3.0415463 2020
Pittsburgh Ballet Theatre -3.3144664 2020
The Tallahassee Ballet -4.1994951 2020
Ballet Quad Cities -4.5315904 2020
Miami City Ballet -4.8106966 2020
San Francisco Ballet -8.4597794 2020
Ballet Memphis -11.6985509 2020
Atlanta Ballet -28.5158513 2020
Orlando Ballet -90.9983829 2020
Joffrey Ballet 146.9046722 2019
First State Ballet Theatre 69.9900000 2019
Dayton Ballet 47.3628143 2019
Richmond Ballet 34.8263002 2019
New Mexico Ballet Company 28.7289611 2019
BalletMet 22.9766213 2019
Kansas City Ballet 14.2884428 2019
Tulsa Ballet 14.0998602 2019
American Ballet Theatre 12.8340039 2019
Grand Rapids Ballet 11.2809947 2019
NA 7.8186556 2019
Ballet Des Moines 6.2713554 2019
Oregon Ballet Theatre 4.1823644 2019
Alvin Ailey American Dance Theater 3.5551869 2019
The Tallahassee Ballet 3.4501860 2019
Houston Ballet 3.0126539 2019
Ballet Austin 2.7039028 2019
Pacific Northwest Ballet 2.5299841 2019
Ballet Hispanico 1.5405288 2019
Miami City Ballet 1.1650569 2019
Pittsburgh Ballet Theatre 0.8461817 2019
Texas Ballet Theater 0.5813097 2019
Fort Wayne Ballet 0.4949803 2019
New York City Ballet 0.0809932 2019
Eugene Ballet 0.0000000 2019
Aspen Santa Fe Ballet 0.0000000 2019
Dance Theatre of Harlem 0.0000000 2019
Milwaukee Ballet -0.2192253 2019
San Francisco Ballet -0.4505953 2019
Madison Ballet -0.6341596 2019
Pennsylvania Ballet -0.6773370 2019
Nevada Ballet Theatre -0.9524021 2019
Charlotte Ballet -1.1038242 2019
Ballet Arizona -1.3078878 2019
The Alabama Ballet -3.6897295 2019
Ballet Memphis -6.1694703 2019
The Sarasota Ballet -15.1497071 2019
Atlanta Ballet -36.6916144 2019
The Washington Ballet -50.1144953 2019
Nashville Ballet -94.4004512 2019
## Ranges of different spend-downs  
# reorder(organization_name, pull(summarize(spend_down, sd = sd(group_by(spend_down, pct_spend_down)))), na.rm = TRUE)
# Reordering by standard deviation of pct_spend down
spend_down_box <- spend_down %>%
  group_by(organization_name) %>%
  filter(pct_spend_down != Inf) %>%
  summarize(sd = sd(pct_spend_down, na.rm = TRUE)) %>%
  right_join(spend_down, by = "organization_name") %>%
  select(organization_name, EIN, pct_spend_down, sd) %>%
  mutate(organization_name = reorder(organization_name, -sd, na.rm = TRUE))

## Unlimited 
box_plot <- ggplot(spend_down_box, aes(x = organization_name, y = pct_spend_down)) + 
  geom_boxplot(aes(color = organization_name), show.legend = FALSE) + 
  geom_point(size = 1, alpha = 0.5) + 
  theme_bw() + 
  labs(title = "Range of Endowment Spend Downper Company",
       x = "Dance Company",
       y = "Percent of Endowment Spend Down") + 
  theme(axis.text.x = element_blank()) + 
  geom_hline(yintercept = 100, linetype = "dotted", color = "maroon")
ggplotly(box_plot) %>%
  layout(showlegend = FALSE)
##Limited to 100 for visibility 
box_plot_lim <- ggplot(spend_down_box, aes(x = organization_name, y = pct_spend_down)) + 
  geom_boxplot(aes(color = organization_name), show.legend = FALSE) + 
  geom_point(size = 1, alpha = 0.5) + 
  theme_bw() + 
  labs(title = "Range of Endowment Spend Down (Max of 100) per Company",
       x = "Dance Company",
       y = "Percent of Endowment Spend Down") + 
  theme(axis.text.x = element_blank()) + 
  scale_y_continuous(breaks = scales::breaks_pretty(n = 20),
                     limit = c(-100,100))
ggplotly(box_plot_lim) %>%
  layout(showlegend = FALSE)